home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 041-050 / amok47 / req / reqdemo.mod < prev    next >
Text File  |  1993-11-04  |  9KB  |  315 lines
  1. MODULE Reqdemo;
  2.  
  3. IMPORT 
  4.    Req,
  5.    Dos,
  6.    Requests,
  7.    Strings,
  8.    SYSTEM,
  9.    I:Intuition,
  10.    E:Exec,
  11.    G:Graphics;
  12.    
  13. VAR
  14.    freqPtr,fontreqPtr: Req.FileRequesterPtr;
  15.    gadblocks: ARRAY 9 OF Req.GadgetBlock;
  16.    dirstring : Req.DirString;
  17.    filestring: Req.FileString;
  18.    wholefilePtr : Req.PathStringPtr;
  19.    ScP: I.ScreenPtr;   
  20.    oldWinP,WinP    : I.WindowPtr;
  21.    IMess   : I.IntuiMessage;
  22.    IMessPtr: I.IntuiMessagePtr;   
  23.    gadgetPtr: I.GadgetPtr;
  24.    myproc : Dos.ProcessPtr;
  25.    gadgetnum : INTEGER;   
  26.    x,y: LONGINT;   
  27.    
  28. TYPE gadstringType = ARRAY 9,34 OF CHAR;
  29.  
  30. CONST gadstrings = gadstringType("Show the file requester.",
  31.                                  "Show the color requester.",
  32.                                  "Show a simple text requester.",
  33.                                  "Show a two gadget requester.",
  34.                                  "Show a three gadget requester.",
  35.                                  "Show the font requester.",
  36.                                  "Show the 'get text' requester.",
  37.                                  "Show the 'get number' requester.",
  38.                                  "Exit the demo.");
  39.  
  40. PROCEDURE OpenAll();
  41.  
  42. VAR
  43.    NSc  : I.NewScreen;
  44.    Nw   : I.NewWindow;
  45.    
  46. BEGIN
  47.  
  48.     NSc.leftEdge     := 0;    NSc.topEdge      := 0;
  49.     NSc.width        := G.gfx.normalDisplayColumns;
  50.     NSc.height       := G.gfx.normalDisplayRows;
  51.     NSc.depth        := 3;    NSc.detailPen    := 0;
  52.     NSc.blockPen     := 1;    NSc.viewModes    := {G.hires};
  53.     NSc.type         := I.customScreen;
  54.     NSc.defaultTitle := SYSTEM.ADR("Show off requester library.");
  55.     NSc.font         := NIL;
  56.     NSc.gadgets      := NIL;  NSc.customBitMap := NIL;
  57.     ScP := I.OpenScreen(NSc); Requests.Assert(ScP#NIL,"Couldn't open screen!");
  58.  
  59.     Nw.leftEdge      := 0;    Nw.topEdge       := 0;
  60.     Nw.width         := NSc.width; Nw.height := NSc.height;
  61.     Nw.detailPen     := -1;    Nw.blockPen      := -1;
  62.     Nw.idcmpFlags    := LONGSET{I.gadgetUp};
  63.     Nw.flags         := LONGSET{I.activate,I.backDrop,I.borderless};
  64.     Nw.firstGadget   := NIL;  Nw.checkMark     := NIL;
  65.     Nw.screen        := ScP;  Nw.bitMap        := NIL;
  66.     Nw.minWidth      := 128;  Nw.minHeight     := 24;
  67.     Nw.maxWidth      := -1;   Nw.maxHeight     := -1;
  68.     Nw.title         := NIL;  Nw.type          := I.customScreen;
  69.     
  70.     gadgetnum := 0;
  71.     REPEAT
  72.       x := Nw.leftEdge + 20 + (gadgetnum MOD 2) * (Nw.width DIV 2);
  73.       y := (Nw.height-4*20) DIV 2 + (gadgetnum DIV 2) * 20;
  74.       Req.LinkGadget(SYSTEM.ADR(gadblocks[gadgetnum]),gadstrings[gadgetnum],Nw, x, y);
  75.       gadblocks[gadgetnum].gadget.gadgetID := gadgetnum;
  76.       INC(gadgetnum);
  77.     UNTIL gadgetnum = 9;
  78.     gadgetPtr := SYSTEM.ADR(gadblocks[8].gadget);
  79.     gadgetPtr.topEdge  := 20;
  80.     gadgetPtr.leftEdge := (Nw.width-gadgetPtr.width) DIV 2;
  81.     
  82.     WinP := I.OpenWindow(Nw); Requests.Assert(WinP#NIL,"Couldn't open window!");
  83.  
  84. END OpenAll;
  85.  
  86. PROCEDURE ShowFileReq();
  87.  
  88. BEGIN
  89.       
  90.    freqPtr.dir   := SYSTEM.ADR(dirstring);
  91.    freqPtr.file  := SYSTEM.ADR(filestring);
  92.    freqPtr.pathName := wholefilePtr;
  93.    freqPtr.flags := LONGSET{Req.infogadget,Req.caching};
  94.    freqPtr.dirnamescolor := 2;
  95.    freqPtr.devicenamescolor := 2;
  96.    freqPtr.show := "*";
  97.    
  98.    IF Req.FileRequest(freqPtr) THEN
  99.       Req.SimpleRequest("You selected the file '%s'.",SYSTEM.ADR(wholefilePtr));
  100.    ELSE
  101.       Req.SimpleRequest("You didn't select a file.",NIL);
  102.    END;
  103.  
  104. END ShowFileReq;
  105.  
  106.  
  107. PROCEDURE ShowColorReq();
  108.  
  109. BEGIN
  110.  
  111.    IF Req.ColorRequester(1) # 0 THEN END;
  112.  
  113. END ShowColorReq;
  114.  
  115.  
  116. PROCEDURE ShowSimpleText();
  117.  
  118. BEGIN
  119.  
  120. Req.SimpleRequest("     SimpleRequest()  is  a  tiny bit of\n\
  121. glue  code  which  passes  a single text\n\
  122. string  (with  optional  printf()  style\n\
  123. formatting) to the TextRequest() routine\n\
  124. in  the  library.   The  SimpleRequest()\n\
  125. routine  can  be  easily modified to fit\n\
  126. your own peculiar purposes.",NIL);
  127.  
  128. END ShowSimpleText;
  129.  
  130.  
  131. PROCEDURE ShowTwoGadText();
  132.  
  133. TYPE yesnoType = ARRAY 2,4 OF CHAR;
  134. CONST yesno = yesnoType("no","yes");
  135.  
  136. VAR result : INTEGER;
  137.     yesnoPtr : POINTER TO ARRAY 4 OF CHAR;
  138. BEGIN
  139.  
  140.    result := Req.TwoGadRequest("Just testing the two gadget requester.",NIL);
  141.    yesnoPtr := SYSTEM.ADR(yesno[result]);
  142.    Req.SimpleRequest("You responded with a '%s' to this requester.",
  143.                      SYSTEM.ADR(yesnoPtr));
  144.  
  145. END ShowTwoGadText;
  146.  
  147.  
  148. PROCEDURE ShowThreeGadText();
  149.  
  150. TYPE responseType = ARRAY 3,66 OF CHAR;
  151.  
  152. CONST response = responseType("You really should use it.",
  153.                               "Excellent choice. You have good taste.",
  154.                               "Oh come on, make up your mind.\nYou won't regret choosing 'yes'.");                              
  155.  
  156. VAR myTextStruct : Req.TRStructurePtr;
  157.     result : INTEGER;
  158.     
  159. BEGIN
  160.  
  161.    NEW(myTextStruct);
  162.    myTextStruct.text := SYSTEM.ADR("     Would you use the requester library\nin your programs?");
  163.    myTextStruct.controls := NIL;
  164.    myTextStruct.window := NIL;
  165.    myTextStruct.middleText := SYSTEM.ADR("Perhaps...");
  166.    myTextStruct.positiveText := SYSTEM.ADR("Oh yeah, for sure!");
  167.    myTextStruct.negativeText := SYSTEM.ADR("Methinks not.");
  168.    myTextStruct.title := SYSTEM.ADR("Show off text requester.");
  169.    myTextStruct.keyMask := {0..15};
  170.    myTextStruct.textcolor := 0;
  171.    myTextStruct.detailcolor := 0;
  172.    myTextStruct.blockcolor := 0;
  173.    myTextStruct.versionnumber := 0;
  174.    myTextStruct.rfu1 := 0;
  175.    myTextStruct.rfu2 := 0;
  176.    result := Req.TextRequest(myTextStruct);
  177.    Req.SimpleRequest(response[result],NIL);
  178.    DISPOSE(myTextStruct);
  179.    
  180. END ShowThreeGadText;
  181.  
  182.  
  183. PROCEDURE ShowFontReq();
  184.  
  185. TYPE restype = RECORD
  186.                   fname : Req.FileStringPtr;
  187.                   size  : LONGINT;
  188.                   style : LONGINT;
  189.                END;
  190.  
  191. VAR fontname : Req.FileString;
  192.     dirname  : Req.DirString;
  193.     result   : restype;
  194.     
  195. BEGIN
  196.  
  197.    dirname := "fonts:";
  198.    fontname := "";
  199.    fontreqPtr.dir  := SYSTEM.ADR(dirname);
  200.    fontreqPtr.file := SYSTEM.ADR(fontname);
  201.    fontreqPtr.fontnamescolor := 2;
  202.    fontreqPtr.flags := LONGSET{Req.caching,Req.getfonts};
  203.    IF Req.FileRequest(fontreqPtr) THEN
  204.       result.fname := fontreqPtr.file;
  205.       result.size  := fontreqPtr.fontYSize;
  206.       result.style := fontreqPtr.fontStyle;
  207.       Req.SimpleRequest("You selected the font '%s',\nsize %ld, type %ld.",
  208.                         SYSTEM.ADR(result));
  209.    ELSE
  210.       Req.SimpleRequest("You didn't select a font.",NIL);
  211.    END;
  212.    
  213. END ShowFontReq;
  214.  
  215.  
  216. PROCEDURE ShowGetString();
  217.  
  218. CONST textlength = 75;
  219.  
  220. VAR mybufferPtr : POINTER TO ARRAY textlength OF CHAR;
  221.     
  222. BEGIN
  223.  
  224.    NEW(mybufferPtr);
  225.    mybufferPtr^ := "The default text.";
  226.    IF Req.GetString(mybufferPtr^,"Type anything, then hit return.",
  227.                     NIL,50,textlength) THEN
  228.       Req.SimpleRequest("I'll bet you typed:\n%s",SYSTEM.ADR(mybufferPtr));
  229.    ELSE
  230.       Req.SimpleRequest("You didn't enter anything!",NIL);
  231.    END;
  232.    DISPOSE(mybufferPtr);
  233.  
  234. END ShowGetString;
  235.  
  236.  
  237. PROCEDURE ShowGetLong();
  238.  
  239. VAR mygetlongstructPtr : Req.GetLongStructPtr;
  240.  
  241. BEGIN
  242.  
  243.    NEW(mygetlongstructPtr);
  244.    
  245.    mygetlongstructPtr.titlebar := SYSTEM.ADR("Enter a number.");
  246.    mygetlongstructPtr.defaultval := 1234;
  247.    mygetlongstructPtr.minlimit := MIN(LONGINT);
  248.    mygetlongstructPtr.maxlimit := MAX(LONGINT);
  249.    mygetlongstructPtr.window := NIL;
  250.    mygetlongstructPtr.versionnumber := 0;
  251.    mygetlongstructPtr.flags := LONGSET{};
  252.    mygetlongstructPtr.rfu2 := 0;
  253.    
  254.    IF Req.GetLong(mygetlongstructPtr) THEN
  255.       Req.SimpleRequest("You entered the number '%ld'.",SYSTEM.ADR(mygetlongstructPtr.result));
  256.    ELSE Req.SimpleRequest("You didn't enter a number.",NIL);
  257.    END;
  258.    
  259.    DISPOSE(mygetlongstructPtr);
  260.  
  261. END ShowGetLong;
  262.  
  263.  
  264. BEGIN
  265.  
  266. OpenAll;
  267. myproc := SYSTEM.VAL(Dos.ProcessPtr,E.FindTask(NIL));
  268. oldWinP := myproc.windowPtr;
  269. myproc.windowPtr := WinP;
  270.  
  271. NEW(freqPtr);
  272. NEW(fontreqPtr);
  273. NEW(wholefilePtr);
  274.  
  275. LOOP
  276.    LOOP
  277.      IMessPtr := E.GetMsg(WinP.userPort);
  278.      IF IMessPtr # NIL THEN EXIT END;
  279.      E.WaitPort(WinP.userPort);
  280.    END;
  281.    IMess := IMessPtr^;
  282.    E.ReplyMsg(IMessPtr);
  283.       
  284.    gadgetPtr := IMess.iAddress;
  285.    gadgetnum := gadgetPtr.gadgetID;
  286.    
  287.    CASE gadgetnum OF
  288.       0: ShowFileReq;|
  289.       1: ShowColorReq;|
  290.       2: ShowSimpleText;|
  291.       3: ShowTwoGadText;|
  292.       4: ShowThreeGadText;|
  293.       5: ShowFontReq;|
  294.       6: ShowGetString;|
  295.       7: ShowGetLong;|
  296.       8: EXIT;|
  297.    ELSE
  298.    END;
  299. END;
  300.  
  301. CLOSE
  302.  
  303. IF freqPtr # NIL THEN Req.PurgeFiles(freqPtr);END;
  304. IF fontreqPtr # NIL THEN Req.PurgeFiles(fontreqPtr);END;
  305. IF freqPtr # NIL THEN DISPOSE(freqPtr);END;
  306. IF fontreqPtr # NIL THEN DISPOSE(fontreqPtr);END;
  307. IF wholefilePtr # NIL THEN DISPOSE(wholefilePtr);END;
  308.  
  309. IF myproc.windowPtr # NIL THEN myproc.windowPtr := oldWinP;END;
  310.  
  311. IF WinP # NIL THEN I.CloseWindow(WinP);END;
  312. IF ScP # NIL THEN I.CloseScreen(ScP);END;
  313.  
  314. END Reqdemo.
  315.